Market Basket Analysis

Introduction

Danielle has asked the team to perform a market basket analysis to help Blackwell’s board of directors better understand the clientele that Electronidex is currently serving and if Electronidex would be an optimal acquisition.

A dataset of transactions has been provided. The dataset contains 9835 transactions and 125 different products over a 30-day period, or about 327 transactions a day. This tells us the retailer is neither large, nor small.

Results, conclusions and recommendations

After the analysis, we conclude Electronidex’s sales are to be categorized in two forms: retail (B2C) and corporate (B2B). Had we had this information previous to our analysis, it would have saved time in the exploration phase. Interesting patterns and item relationships found:

Retail by products:

Retail by category:

Corporate by products:

Corporate by categories:

Would Blackwell benefit in selling Electronidex’s items? As a conclusion, we do recommend that Blackwell acquires Electronidex for the following reasons:

• Product portfolio diversification and customer base expansion: Having previously analyzed the current products that Blackwell supplies to its customers, we believe that new product categories will help reach new customers. Additionally, all clients acquired with Eltronidex will become part of Blackwell’s customer base. The combination of diversifaction and expansion will consequentially increase Blackwell’s revenue.

• Beneficial Product Association: Since Blackwell currently works with close to 50% of brands shared by Electronidex; Blackwell can take advantage of the discovered associations. This will imply the average amount of Blackwell’s items per transaction will be increased.

• New potential strategies to adopt by Blackwell’s sales team: The aforementioned results opens new marketing possibilities. Extracting the associations with high confidence and low support (sold less often), it is possible to boost sales for those products (through advertisement and other sales actions). The increase in sales number of the said products will bring in increased revenue since we are confident the new transactions will increase sales volume. Blackwell could create some item packs of those items that are more often purchased at the same transaction, in order to also increase sales volume. Additionally, the rules that we found can be also helpful to provide recommendations to users when they purchase through the e-commerce platorm.

Limitations and observations:

Properties of the dataset:

1. The iMac is the product most bought, in 20% of all transactions. This high number stands out considering the large variety of products, especially being the iMac a pricey product. If this number is representative of all sales throughout the year, then Electronidex is potentially profitable.
2. The mean of items bought per transaction is almost 5. Logically, we would say most people in the real world would buy 1 or 2 items per transactions most frequently, in an eletronics store.

Loading Packages and importing datasets

pacman::p_load(readr, rstudioapi, ggplot2, party, dplyr, arules, arulesViz, 
    RColorBrewer, readxl, tidyr, Hmisc)
setwd("..")
trans <- read.transactions("./Datasets/ElectronidexTransactions2017.csv", format = "basket", 
    sep = ",", rm.duplicates = TRUE)
labels <- read_excel("./Datasets/ElectronidexItems2017.xlsx")

results <- read.csv("./Datasets/results.csv")

Preprocessing

labels[is.na(labels)] <- "Unknown"
summary(trans)

transactions as itemMatrix in sparse format with
 9835 rows (elements/itemsets/transactions) and
 125 columns (items) and a density of 0.03506172 

most frequent items:
                    iMac                HP Laptop CYBERPOWER Gamer Desktop 
                    2519                     1909                     1809 
           Apple Earpods        Apple MacBook Air                  (Other) 
                    1715                     1530                    33622 

element (itemset/transaction) length distribution:
sizes
   0    1    2    3    4    5    6    7    8    9   10   11   12   13   14 
   2 2163 1647 1294 1021  856  646  540  439  353  247  171  119   77   72 
  15   16   17   18   19   20   21   22   23   25   26   27   29   30 
  56   41   26   20   10   10   10    5    3    1    1    3    1    1 

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  0.000   2.000   3.000   4.383   6.000  30.000 

includes extended item information - examples:
                            labels
1 1TB Portable External Hard Drive
2 2TB Portable External Hard Drive
3                   3-Button Mouse

trans@itemInfo$labels <- labels$ProductType
trans@itemInfo$category <- labels$Category

trans_matrix <- as(trans, "matrix")
trans_df <- as.data.frame(trans_matrix)
# Turning into a sparematrix of 1s and 0s.
for (i in 1:ncol(trans_df)) {
    trans_df[, i] <- as.integer(trans_df[, i])
}

Feature Engineering

# Counting number of items
nitems <- c()
for (i in 1:nrow(trans_df)) {
    nitems <- c(nitems, sum(trans_df[i, ]))
}
trans_df$nitems <- nitems
trans_df$laptops <- trans_df[, which(colnames(trans_df) == "LG Touchscreen Laptop")] + 
    trans_df[, which(colnames(trans_df) == "Acer Aspire")] + 
trans_df[, which(colnames(trans_df) == "HP Laptop")] + trans_df[, which(colnames(trans_df) == 
    "ASUS Chromebook")] + trans_df[, which(colnames(trans_df) == "Apple Macbook Pro")] + 
    trans_df[, which(colnames(trans_df) == "Apple MacBook Air")] + trans_df[, 
    which(colnames(trans_df) == "Dell Laptop")] + trans_df[, which(colnames(trans_df) == 
    "Eluktronics Pro Gaming Laptop")] + trans_df[, which(colnames(trans_df) == 
    "Alienware AW17R4-7345SLV-PUS 17\" Laptop")] + trans_df[, which(colnames(trans_df) == 
    "HP Notebook Touchscreen Laptop PC")]
trans_df$desktop <- trans_df[, which(colnames(trans_df) == "Lenovo Desktop Computer")] + 
    trans_df[, which(colnames(trans_df) == "iMac")] + trans_df[, which(colnames(trans_df) == 
    "HP Desktop")] + trans_df[, which(colnames(trans_df) == "ASUS Desktop")] + 
    trans_df[, which(colnames(trans_df) == "Dell Desktop")] + trans_df[, which(colnames(trans_df) == 
    "Intel Desktop")] + trans_df[, which(colnames(trans_df) == "Acer Desktop")] + 
    trans_df[, which(colnames(trans_df) == "CYBERPOWER Gamer Desktop")] + trans_df[, 
    which(colnames(trans_df) == "Dell 2 Desktop")]
trans_df$tablet <- trans_df[, which(colnames(trans_df) == "iPad")] + trans_df[, 
    which(colnames(trans_df) == "iPad Pro")] + trans_df[, which(colnames(trans_df) == 
    "Fire HD Tablet")] + trans_df[, which(colnames(trans_df) == "Samsung Galaxy Tab")] + 
    trans_df[, which(colnames(trans_df) == "Kindle")]
trans_df$printer <- trans_df$`Epson Printer` + trans_df$`HP Wireless Printer` + 
    trans_df$`Canon Office Printer` + trans_df$`Brother Printer` + trans_df$`DYMO Label Manker`
trans_df$nmain <- trans_df$printer + trans_df$laptops + trans_df$desktop + trans_df$tablet
trans_df$ncomp <- trans_df$nitems - trans_df$nmain
trans_df$value <- 10 * trans_df$nmain + trans_df$ncomp

Visualizations

Here we make several plots to see the distribution of our variables and also see the frequency of the products bought.

products <- c("laptops", "desktop","printer","tablet")
for (i in products){
  print(ggplot(trans_df, aes_string(x = i)) + 
          geom_bar(fill = "lightgreen", bins = 100) + 
           
      ggtitle(paste("Histogram of",i)))
}

for (i in products) {
    for (j in products[-1]) {
        if (i != j | j != i) {
            print(ggplot(trans_df, aes_string(x = i, y = j, color = i)) + geom_jitter() + 
                ggtitle(paste("Scatterplot of", j, "vs", i)))
            
        }
        
    }
}

ggplot(trans_df, aes(x = nmain, y = ncomp)) + geom_jitter(color = "lightgreen")

Splitting dataframe between corporates and retailers

# Filtering. Corporate will be those transactions with more than 2 main
# products and 3 complements.
corporate <- filter(trans_df, nmain >= 2 | ncomp >= 3)
# Cleaning the new columns we created before
corporate <- corporate[, -which(colnames(corporate) %in% c("laptops", "desktop", 
    "printer", "tablet", "nitems", "nmain", "value", "ncomp"))]
# Filtering. Retailers will be those transactions with less than 2 main
# products and 3 complements.
retailer <- filter(trans_df, nmain <= 1 & ncomp <= 2)
# Cleaning
retailer <- retailer[, -which(colnames(retailer) %in% c("laptops", "desktop", 
    "printer", "tablet", "nitems", "nmain", "value", "ncomp"))]
# Transforming the dataframe into a transaction objecte
trans_corp <- as(corporate == 1, "transactions")
trans_retail <- as(retailer == 1, "transactions")
# Inserting labels and the level category
trans_corp@itemInfo$labels <- labels$ProductType
trans_corp@itemInfo$category <- labels$Category
trans_retail@itemInfo$labels <- labels$ProductType
trans_retail@itemInfo$category <- labels$Category

itemFrequencyPlot(trans_corp, topN = 10, type = "relative", col = brewer.pal(8, 
    "Pastel2"), main = "Corp Relative Item Frequency Plot")

itemFrequencyPlot(trans_retail, topN = 10, type = "relative", col = brewer.pal(8, 
    "Pastel2"), main = "Retail Relative Item Frequency Plot")

Creating rules via apriori algorithm

# Function to create the average
averagetor <- function(rules_corpro) {
    
    # The most populars products
    a <- head(rules_corpro[order(-rules_corpro[, which(colnames(rules_corpro) == 
        "support")]), ], 10)
    # Items that have high chances of being bought together
    b <- head(rules_corpro[order(-rules_corpro[, which(colnames(rules_corpro) == 
        "support")]), ], 10)
    # Lift
    c <- head(rules_corpro[order(-rules_corpro[, which(colnames(rules_corpro) == 
        "support")]), ], 10)
    
    corpro <- rbind(a, b, c)
    corpro <- corpro[!duplicated(corpro), ]
    
    
    d <- scale(corpro[, which(colnames(corpro) %in% c("support", "confidence", 
        "lift"))])
    
    average <- (d[, which(colnames(d) == "support")] + d[, which(colnames(d) == 
        "confidence")] + d[, which(colnames(d) == "lift")])/3
    corpro <- cbind(corpro, average)
    corpro <- head(corpro[order(-average), ], 10)
    
    return(corpro)
}

rules_corpro <- apriori(trans_corp, parameter = list(supp = 0.001, conf = 0.01, 
    minlen = 2))
rules_corpro <- rules_corpro[!is.redundant(rules_corpro)]

summary(rules_corpro)
rules_corpro <- as(rules_corpro, "data.frame")

corpro <- averagetor(rules_corpro)

kable(corpro)

trans_corcat <- aggregate(trans_corp, by = "category")
rules_corcat <- apriori(trans_corcat, parameter = list(supp = 0.001, conf = 0.01, 
    minlen = 2))
rules_corcat <- rules_corcat[!is.redundant(rules_corcat)]

summary(rules_corcat)
rules_corcat <- as(rules_corcat, "data.frame")

corcat <- averagetor(rules_corcat)

kable(corcat)

rules_retpro <- apriori(trans_retail, parameter = list(supp = 0.001, conf = 0.01, 
    minlen = 2))
rules_retpro <- rules_retpro[!is.redundant(rules_retpro)]

summary(rules_retpro)
rules_retpro <- as(rules_retpro, "data.frame")

retpro <- averagetor(rules_retpro)

kable(retpro)

trans_retcat <- aggregate(trans_retail, by = "category")
rules_retcat <- apriori(trans_retcat, parameter = list(supp = 0.001, conf = 0.01, 
    minlen = 2))
rules_retcat <- rules_retcat[!is.redundant(rules_retcat)]
summary(rules_retcat)
rules_retcat <- as(rules_retcat, "data.frame")

retcat <- averagetor(rules_retcat)

kable(retcat)

Rules visualizations

methods <- c("graph", "scatterplot")
for (i in methods) {
    plot(rules_corpro, method = i, control = list(type = "items"), max = 10, 
        main = paste(capitalize(i), "of rules of products bought by corporates"))
    plot(rules_corcat, method = i, control = list(type = "items"), max = 10, 
        main = paste(capitalize(i), "of rules of categories bought by corporates"))
    plot(rules_retpro, method = i, control = list(type = "items"), max = 10, 
        main = paste(capitalize(i), "of rules of products bought by retailers"))
    plot(rules_retcat, method = i, control = list(type = "items"), max = 10, 
        main = paste(capitalize(i), "of rules of categories bought by retailers"))
}

results <- rbind(retpro[1:3, which(colnames(retpro) %in% c("lhs", "Var.2", "rhs", 
    "average"))], retcat[1:3, which(colnames(retcat) %in% c("lhs", "Var.2", 
    "rhs", "average"))], corpro[1:3, which(colnames(corpro) %in% c("lhs", "Var.2", 
    "rhs", "average"))], corcat[1:3, which(colnames(corcat) %in% c("lhs", "Var.2", 
    "rhs", "average"))])

write.csv(results, "results.csv")